#!/usr/bin/perl
#
#  Description: Convert tiff images to jpeg via email
#
#  Author: Igor Homyakov <homyakov at gmail . com>
# 
#  TODO: 
#    + limit resources
#    + limit execution time
#    - sender ACL
#    - add support for PDF attachments

use strict;
use warnings;

use Carp;
use MIME::Parser;
use File::Temp qw/ tempdir /;
use Image::Magick;
use Date::Format;
use IO::Handle;

# magick numbers :)
my $Image_Size_Limit = 500*1024; # 500k
my $Loop_Limit = 200; 	  # to avoid forever loop 
my $JPEG_Quality = 85;
my $Converter_Email = 'tif2jpg@spb.ancor.ru';
my $Temp_Dir = tempdir(CLEANUP => 1); # set to 1 for production
my $Log_Filename = "converter.log";
my $Logging = 1;

END  { close(LOG); }

### BEGIN 
open(LOG, '>>', $Log_Filename) or croak "Error opening log file";
LOG->autoflush(1);

write_log("BEGIN");

my $parser = new MIME::Parser;
umask(0033);
$parser->output_dir($Temp_Dir);

my $entity = $parser->parse(\*STDIN);
my $Sender = $entity->head()->get('From');
write_log("Recieved message from $Sender");

my @files;

write_log("Extract attaches");
decode_entities($entity);

# TODO:
#  - don't send empty email
write_log("Convert TIFF images to JPEG");
my @jpegs = map(tif2jpg($_), @files);

write_log("Build reply message to $Sender");
my $msg = MIME::Entity->build(
    To      => $Sender,
    From    => $Converter_Email,
    Subject => "tiff to jpeg converter",
    Data    => "image attached",
    );


foreach ( @jpegs ) {
    write_log("Attach file $_");
    $msg->attach(
	Path     => $_,
	Type     => "image/jpg",
	Encoding => "base64",
	Disposition=>"attachment",
	);
}

write_log("Send email to $Sender");
# TODO: rewrite with Mail::Mailer, MIME::Lite or something similar
open(SENDMAIL, "|/usr/sbin/sendmail -t") or croak "sendmail: $!";
$msg->print(\*SENDMAIL);
close(SENDMAIL) or croak "sendmail failed: $!";

write_log("Remove temp files");
$parser->filer->purge;
write_log("END");
### END 

sub decode_entities {
    my $ent = shift;
    if ( my @parts = $ent->parts ) {
	decode_entities($_) for @parts;
    } else  { 
	my $type = $ent->head->mime_type;
	if ( $type =~ q@image/tiff@ ) {
	    my $filename = save_attachment($ent);
	    push @files, $filename;
	}
    }
}


# TODO
#   - save any file type ( mime -> .ext )
sub save_attachment {
    my $ent = shift;
    my $fh = $ent->open("r");
    my $i = 0;
    my $fname = $Temp_Dir . "/" . $i . ".tif";
    while ( -e $fname ) {
	$i++;
	$fname = $Temp_Dir . "/" . $i . ".tif";
    }
    open(FH, ">$fname") or croak "Error opening file $fname";
    while ( defined($_ = $fh->getline) ) {
	print FH $_;
    }
    write_log("Save file: $fname");
    close(FH);
    $fh->close;
    return $fname
}

sub tif2jpg {
    my $fname = shift;
    my $j_fname;
    my $f_id = sprintf("%03d", int(rand(500))); # create unique id
    my $filename = time2str("%Y%m%d-", time) . $f_id . ".jpg";
    ($j_fname = $fname) =~ s([^/]+\.tif$){$filename}e;
    
    my $fsize = $Image_Size_Limit; # for first loop iteration
    
    my $count = 0;
    my $step  = 2;

    while ( $fsize >= $Image_Size_Limit ) {
    	my ($w, $h, $k);
	write_log("Read TIFF file $fname");
    	# read image from a file
	my $magick = new Image::Magick(format => "tif");
   	my $status = $magick->Read(filename => $fname);
    	carp "Error reading TIFF input: $status" if $status;
	if ( $count ) {
    		($w, $h) = $magick->Get('width', 'height');
		write_log("TIFF size: ${w}x${h}");
		$k = 1 - $count/100;
		$magick->Resize(width => $w*$k, height => $h*$k);
		write_log("Image resized to " . int($w*$k) . "x" . int($h*$k));
	}

	open(FH, ">$j_fname") or croak "Error open file: $j_fname";
	write_log("Write JPEG file $j_fname");
	$status = $magick->Write( 
	    file => \*FH, 
	    filename => $j_fname, 
	    compression => 'JPEG', 
	    quality=> $JPEG_Quality
	);
	croak "Error writing JPEG output: $status" if $status;
	close(FH);
	undef $magick;

	$fsize = -s $j_fname;
	$count += $step;
	write_log("JPEG file size is $fsize bytes");
	# avoid forever loops
	croak "Reached loop limit. Died" if ($count >= $Loop_Limit);
    }

    return $j_fname;
}

sub write_log {
	if ($Logging) {
		my $t_stamp = time2str("%b %d %T", time);
        	print LOG "$t_stamp $$ $_[0]\n";
  }	
}
